Ham Radio 2000 #1/Ham Radio 2000.iso/ham2000/packet/p_aa4re/bb212src/bbsettb.pas

Pascal/Delphi Source File | 1989-02-19 | 10.3 KB | 386 lines

{$M 8192,128000,655360} {Stack, minheap, maxheap}
PROGRAM bbsettnc;
(*===========================================================================*)
(*                                                                           *)
(*   Copyright 1988, 1989 by H. Roy Engehausen.  All rights reserved.        *)
(*   This software may be freely distributed and used, but it may not        *)
(*   under any circumstances be sold by anyone other than the author.        *)
(*   It may be distributed by a commercial company as long as it is          *)
(*   for no cost.                                                            *)
(*                                                                           *)
(*   Permission is explicity granted to use this code as a model for         *)
(*   other programs as long as they carry this copyright notice and the      *)
(*   imbedded copyright constants                                            *)
(*                                                                           *)
(*===========================================================================*)

{$R+}    {Range checking on}
{$B-}    {Boolean complete evaluation off}
{$S+}    {Stack checking on}
{$I+}    {I/O checking on}
{$V+}    {String var checks}
{$F+}    {Must have far calls}
{$N-}    {No numeric coprocessor}

(*===========================================================================*)
(* Globals                                                                   *)
(*===========================================================================*)

USES
  CRT,
  DOS,
  bbdummy,
  bbfsm,
  bbstr;

(*===========================================================================*)
(* Constants                                                                 *)
(*===========================================================================*)

CONST
  in_file_name = 'BBOPT.BB';


(*===========================================================================*)
(* Imported definitions                                                      *)
(*===========================================================================*)

{$I 8250CON.PAS}
{$I BBOTYPE.PAS}

(*===========================================================================*)
(* Vars                                                                      *)
(*===========================================================================*)

VAR

  com_done    : ARRAY[1..50] OF INTEGER;
  com_count   : BYTE;
  com_index   : BYTE;
  in_file     : FILE OF opt_file_rec;
  opt_buffer  : opt_file_rec;
  p_cnt       : BYTE;
  r           : registers;

(*===========================================================================*)
(* Send/Receive a PC/TNC                                                     *)
(*===========================================================================*)

PROCEDURE sr_pcpa(s : STRING);

  VAR
    i : BYTE;

  BEGIN;

    WITH opt_buffer.opt_port_file, r DO
      BEGIN;

        i := 0;

        WHILE i < LENGTH(s) DO
          BEGIN;

            i := i + 1;

            AH := 1;
            AL := ORD(s[i]);

            INTR(com_number, r);

            IF AH = 1 THEN
              WRITE(CHR(AL));

          END;

        i := 0;

        REPEAT
          INC(i);

          AX := 0;

          INTR(com_number, r);

          IF AH = 1 THEN
            BEGIN;
              WRITE(CHR(AL));
              i := 0;
            END;

        UNTIL i = 250;

      END;

  END;

(*===========================================================================*)
(* Send a string to the TNC                                                  *)
(*===========================================================================*)

PROCEDURE send_tnc(s : STRING);

  VAR
    i : BYTE;

  BEGIN;

    WITH opt_buffer.opt_port_file, r DO
      BEGIN;

        IF port_type = port_pcpa THEN
          BEGIN;
            sr_pcpa(s);
            EXIT;
          END;

        i := 0;

        WHILE i < LENGTH(s) DO
          BEGIN;

            i := i + 1;

            AH := 1;
            AL := ORD(s[i]);
            DX := com_number - 1;

            INTR(tnc_interrupt, r);

          END;

      END;

  END;

(*===========================================================================*)
(* Receive all data from the TNC and throw it away                           *)
(*===========================================================================*)

PROCEDURE discard_tnc;

  BEGIN;

    WITH opt_buffer.opt_port_file, r DO
      BEGIN;

        IF port_type = port_pcpa THEN
          BEGIN;
            sr_pcpa('');
            EXIT;
          END;

        WHILE TRUE DO
          BEGIN;

            AH := 3;
            DX := com_number - 1;

            INTR(tnc_interrupt, r);

            AH := AH AND lsr_8250_dr;

            IF AH = 0 THEN EXIT;

            AH := 2;
            DX := com_number - 1;

            INTR(tnc_interrupt, r);

            WRITE(CHR(AL));

          END;
      END;

  END;

(*===========================================================================*)
(* Do a port                                                                 *)
(*===========================================================================*)

PROCEDURE do_port;
  VAR
    i : BYTE;

  BEGIN;

    WITH opt_buffer.opt_port_file, r DO
      BEGIN;

        FOR com_index := 1 TO com_count DO
          IF com_done[com_index] = com_number THEN
            EXIT;

        INC(com_count);
        com_done[com_count] := com_number;

        WRITELN;
        WRITELN('Setting up COM', com_number);
        WRITELN;

        IF port_type <> port_pcpa THEN
          BEGIN;
            AH := 4;
            DX := com_number - 1;
            INTR(tnc_interrupt, r);
            IF AX <> $AA55 THEN
              BEGIN;
                WRITELN;
                WRITELN('***** ERROR *****');
                WRITELN('MBBIOS not active for this COM port');
                HALT(1);
              END;
          END;

        AH := 0;

        CASE data_rate OF
          110  : AL := 0;
          150  : AL := $20;
          300  : AL := $40;
          600  : AL := $60;
          1200 : AL := $80;
          2400 : AL := $A0;
          4800 : AL := $C0;
          9600 : AL := $E0;
        END;

        IF port_type <> port_pc1xx THEN
          AL := AL OR $03;

        DX := com_number - 1;

        IF port_type <> port_pcpa THEN
          INTR(tnc_interrupt, r);

        IF port_host_only THEN
          EXIT;

        IF port_type = port_aeapk232 THEN
          BEGIN;
            FOR i := 1 TO 3 DO
              BEGIN;
                discard_tnc;
                send_tnc('*');
                DELAY(1000);
              END;
            DELAY(1000);
          END;

        discard_tnc;

        IF port_type <> port_aeapk232 THEN
          send_tnc(^A^A^I^Q^X^['JHOST1'^M)
        ELSE
          BEGIN;
            send_tnc(#$11);
            DELAY(10);
            send_tnc(#$18);
            DELAY(10);
            send_tnc(#$03);
            DELAY(10);
            send_tnc('HO');
            DELAY(10);
            send_tnc('ST');
            DELAY(10);
            send_tnc(' Y');
            DELAY(10);
            send_tnc(cr);
          END;

        DELAY(1000);

        discard_tnc;

        IF port_type <> port_aeapk232 THEN
          send_tnc(#01#01#01'@B');

        IF port_type <> port_aeapk232 THEN
          send_tnc(^A^A^I^Q^X^['JHOST1'^M)
        ELSE
          send_tnc(#$01#$01#$4F#$47#$47#$17);

        DELAY(1000);

        discard_tnc;

        DELAY(1000);

        discard_tnc;

      END;

  END;

(*===========================================================================*)
(* Main program begins here                                                  *)
(*===========================================================================*)

BEGIN

  WRITELN(this_bbs_version);
  WRITELN('Copyright 1988, 1989, H.R. Engehausen.                          ');
  WRITELN('This software may be freely distributed and used, but it may not');
  WRITELN('under any circumstances be sold by anyone other than the author.');
  WRITELN('It may be distributed by a commercial company as long as it is  ');
  WRITELN('for no cost.                                                    ');

  (*-------------------------------------------------------------------------*)
  (* Initialize                                                              *)
  (*-------------------------------------------------------------------------*)

  com_count := 0;

  (*-------------------------------------------------------------------------*)
  (* Open the file                                                           *)
  (*-------------------------------------------------------------------------*)

  ASSIGN(in_file, in_file_name);

  {$I-}
  RESET(in_file);
  {$I+}
  IF IORESULT <> 0 THEN
    BEGIN;
      WRITELN;
      WRITELN('***** Cannot open ', in_file_name);
      WRITELN;
      HALT(1);
    END;

  READ(in_file, opt_buffer);
  opt_block := opt_buffer.opt_block_file;

  (*-------------------------------------------------------------------------*)
  (* Verify option block                                                     *)
  (*-------------------------------------------------------------------------*)

  WITH opt_block DO
    IF parm_file_ver <> this_bbs_parms THEN
      BEGIN;
        WRITELN;
        WRITELN('Incorrect version of the PARMS.BB has been found.');
        WRITELN('Expected ', this_bbs_parms,
                ' but got ', parm_file_ver, '.');
     WRITELN('Rerun the proper version of BBSETUP that matches this program');
        WRITELN;
        WRITELN;
        HALT(1);
      END;

  (*-------------------------------------------------------------------------*)
  (* Process the ports                                                       *)
  (*-------------------------------------------------------------------------*)

  p_cnt := opt_buffer.opt_block_file.port_count;
  WHILE p_cnt > 0 DO
    BEGIN;
      DEC(p_cnt);
      READ(in_file, opt_buffer);
      do_port;
    END;

  CLOSE(in_file);

END.